(defpackage :highlight-arrows
  (:use :cl)
  (:nicknames :ha)
  (:export :highlight-arrows-mixin
           :highlight-arrows))

(in-package :highlight-arrows)

(defclass highlight-arrows-mixin ()
  ())

(defun clear-arrows (trial)
  (d:funcall-on-tree (lambda (n) (setf (d:arrow-color n) nil))
                     (d:root (p:diagram trial))
                     :only-type 'd:argument))

(exp:define-action highlight-arrows ((trial highlight-arrows-mixin)
                                     (e::mouse-motion :var motion)
                                     (bt:select-mode))
  (clear-arrows trial)
  (when (getf motion :enter)
    (let* ((enter (d:find-id-or-die (d:root (p:diagram trial)) (getf motion :enter)))
           (node (if (and (typep enter 'd:argument)
                          (d:quantity enter))
                     (tree:parent enter)
                     enter)))
      (etypecase node
        (d:argument
         (setf (d:arrow-color node) (gwee:color 255 100 100)))
        (d:box
         (dolist (p (tree:parents node))
           (setf (d:arrow-color p) `((,node ,(gwee:color 255 100 100))))))))))

(defmethod p:navigate :after ((problem highlight-arrows-mixin) how &optional post-navigation-fn)
  (clear-arrows problem))
